perm filename PUB2.SAI[PUB,TES]2 blob
sn#072560 filedate 1973-11-15 generic text, type T, neo UTF8
00100 BEGIN "PUB2"
00200 REQUIRE "VERSION.SAI" SOURCE_FILE;
00300 REQUIRE 6500 STRING_SPACE ;
00400 COMMENT The Document Compiler -- Pass Two ;
00500 COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
00600 Height Width
00700 For each area:
00800 UpperLine NumCols NumLines
00900 For each column:
01000 LeftChar
01100 For each non-null line: LineNo SHORTM Index of PUInS.PUI line
01200 0
01300 -10
01400
01500 PASS 2 reads the output file name and the intermediate page file names from
01600 PUPSEQ.PUI, and the label table from PULABL.PUI. Then it reads
01700 each page from each page file, processes each line in each of
01800 its areas, and writes out a line printer image on the output file.
01900
02000 Each line is subject to three operations, in this order:
02100 (1) Substitute label values at each vertical tab.
02200 (2) Justify the line, if required, by inserting spaces at word breaks marked by altmodes.
02300 (3) Generate underlining and super/sub-scripting as indicated by rubouts.
02400
02500 ;
02600
02700 DEFINE THRU = "STEP 1 UNTIL", DOWN = "STEP -1 UNTIL",
02750 TES = "COMMENT", RKJ = "COMMENT", TVR = "COMMENT",
02800 ie = "COMMENT", AWHILE = "WHILE TRUE",
02900 INP(BRKTBL) = "INPUT(SCHAN, BRKTBL)", INNUM = "WORDIN(ICHAN)",
03000 SCN(BRKTBL)="(IF FROMFILE THEN INPUT(SCHAN,BRKTBL) ELSE SCAN(OWL,BRKTBL,PAGEBRC))",
03100 SCNUM = "CVD(SCN(TO_ALTMODE_SKIP))",
03200 LPT = "1", TTY = "2", MIC = "3", XGP = "4",
03300 HORIZ="'40", VERTI="'41", CSIZE="'42", ULINE="'43", RSPCS="'44",
03400 LSPCS="'45", UDOTS="'46", RDOTS="'47", comment FR80 escape codes ;
03500 FULSTR(X) = "LENGTH(X)", NULSTR(X) = "(LENGTH(X)=0)",
03600 CR = "'15", LF = "'12", VT = "'13", FF = "'14", SP = "'40",
03700 RUBOUT = "'177", TB = "'11",
03800 ALTMODE = IFC VERSION=SAILVER THENC "'175" ELSEC "'176" ENDC,
03900 TO_ALTMODE_SKIP = "1", TO_LF_APPD = "2",
04000 ONE_CHAR = "3", BREAKER = "4", TO_RUB_ALT_SKIP = "5",
04100 FIML = "256",
04200 ANS(A) = "(S = ""A"" OR S = ""A"" + '40)";
04300 DEFINE COMMENT FOR XGP;
04400 USEA="('177&'14)", USEB="('177&'15)", VSB="('177&'20)",
04500 XTAB="('177&'30)",
04600 XGPNUM(N)="((N LSH -7) & N)";
04700 DEFINE ESCAPE1="('177&'1)", ESCAPE2="('177&'2)";
04800 DEFINE CTLF="6", CTLE="5", CTLT="'24";
04900 INTEGER IML, IMC, comment, no. of lines and chars per page image ;
05000 DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
05100 LFTMAR, comment Stanford XGP left margin (for tabs) ;
05140 TES LFTMAR used at PARC too but always 0 now;
05200 LISTCHAN, comment output file ;
05250 BAR, TES underlining character (or 0 if OFF) 10/22/73;
05300 PAGEHIGH, PAGEWIDE, comment IML and IMC for latest page ;
05400 I, J, K, L, M, N, DUMMY, comment general-purpose ;
05500 LABCHAN, LABBRC, LABEOF, comment PULABL.PUI info ;
05600 NL, comment LABTAB upper bound ; PAGECT, comment counts pages ;
05700 TABLE, comment LABTAB first subscript -- selects Pass 1 NUMBER vs ITBL ;
05800 ICHAN, SCHAN, FROMFILE, PAGEBRC, PAGEEOF, comment PUIn[S].PUI info ;
05900 TOPLINE, NCOLS, NLINES, comment Area info ;
06000 COL, LEFTCH, comment Column info ;
06100 SLIDETOP, comment top of ∞ stacks such as SLIDESG ;
06200 NCSIZE,CCSIZE, NHORIZ,CHORIZ, NVERTI,CVERTI, comment microfilm normal/current settings ;
06300 NEEDCR, comment, assures CR before every LF for Stanford LPT ;
06400 CHARW, LINENO, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
06500 TERM, TERMX, LINE, UNDERLINE, CHAR, F, G, LAST, LASL, AVAIL ; comment, Justify info ;
06600
06700 INTEGER SCRIPT, comment baseline adjustment ;
06800 THISFONT, comment PARC font number for scripts;
06900 SCRLVL, comment baseline level ;
07000 BASELINE ; comment useful? for underscore at stanford ;
07100
07140 INTEGER TLFTMAR ; TVR temporary left margin in XGP pts;
07180
07200 INTEGER FLUSHING, FSIZE; comment kludges for XGP ;
07300 EXTERNAL INTEGER RPGSW ;
07400
07500 IFC VERSION=PARCVER THENC
07600 SIMPLE PROCEDURE FOOBAZ;
07700 START!CODE "FOOBAZ"
07800 LABEL EVEC,GO,STRT,REEN;
07900 EVEC: JRST STRT;
08000 JRST REEN;
08100 HRRZ 1,'120;
08200 JRST 1(1);
08300 STRT: HRRZ 1,'120;
08400 JRST (1);
08500 REEN: HRRZ 1,'124;
08600 JRST (1);
08700 GO: MOVEI 1,'400000;
08800 MOVEI 2,EVEC;
08900 HRLI 2,3;
09000 '104000000204;
09100 '104000000170;
09200 END "FOOBAZ";
09300 ENDC
00100 STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S,
00200 OWL, SS, T, ENDLINE, RESTARTLINE, ENDPAGE, DELINT, CRLF, JOBNO ;
00300
00400
00500 REAL RATIO ;
00600
00700 INTEGER ARRAY CHARTBL[0:127], XFILL,XINF,SLIDESG,RB,LBD[1:5] ;
00800
00900 STRING ARRAY LBF[1:5] ;
01000
01100 INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
01200 BEGIN "READIN"
01300 INTEGER CH ;
01400 CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
01500 LOOKUP(CH, FILENAME & JOBNO, 0) ; RETURN(CH) ;
01600 END "READIN" ;
01700
01800 INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME) ;
01900 BEGIN "WRITEON"
02000 INTEGER CH ;
02100 CH ← GETCHAN ; OPEN(CH, "DSK", 0,0,2,0, 0, 0) ;
02200 ENTER(CH, FILENAME, 0) ; RETURN(CH) ;
02300 END "WRITEON" ;
02400
02500 SIMPLE PROCEDURE WARN(STRING MESSG) ; OUTSTR(MESSG&CR&LF) ;
02600
02700 SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ; WARN("Impossible case index for "&HOW) ;
02800 STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
02900 RETURN('177 & OP & (IF OP≤'42 THEN (ARG DIV 128)&(ARG MOD 128) ELSE ARG)) ;
03000 STRING SIMPLE PROCEDURE SETSIZE(INTEGER N) ; RETURN(MICROFILM(CSIZE, CCSIZE ← N)) ;
03100 STRING SIMPLE PROCEDURE SETHORIZ(INTEGER N) ; RETURN(MICROFILM(HORIZ, CHORIZ ← N)) ;
03200 STRING SIMPLE PROCEDURE SETVERTI(INTEGER N) ; RETURN(MICROFILM(VERTI, CVERTI ← N)) ;
03300 STRING SIMPLE PROCEDURE DOULINE(INTEGER N) ; RETURN(MICROFILM(ULINE, N)) ;
03400 STRING SIMPLE PROCEDURE DORSPCS(INTEGER N) ; RETURN(MICROFILM(RSPCS, N)) ;
03500 STRING SIMPLE PROCEDURE DOLSPCS(INTEGER N) ; RETURN(MICROFILM(LSPCS, N)) ;
03600 STRING SIMPLE PROCEDURE DOUDOTS(INTEGER N) ; RETURN(MICROFILM(UDOTS, N)) ;
03700 STRING SIMPLE PROCEDURE DORDOTS(INTEGER N) ; RETURN(MICROFILM(RDOTS, N)) ;
03800
03900 RECURSIVE STRING PROCEDURE VARBLANK(INTEGER N);
04000 BEGIN "VARBLANK"
04100 IFC VERSION=CMUVER THENC
04200 IF N ≤ 0 THEN RETURN(NULL) ELSE
04300 IF N ≥ 128 THEN RETURN(VSB & 127 & VARBLANK(N-127)) ELSE
04400 RETURN(VSB&N)
04500 ELSEC IFC VERSION=SAILVER THENC
04600 IF N ≤ 0 THEN RETURN(NULL) ELSE
04700 IF N ≥ 64 THEN RETURN(ESCAPE2 & 63 & VARBLANK(N-63)) ELSE
04800 RETURN(ESCAPE2&N)
04900 ELSEC IFC VERSION=PARCVER THENC
05000 RETURN(CTLE&CVS(N)&".")
05100 ENDC ENDC ENDC;
05200 END "VARBLANK";
05300
05400 PRELOAD_WITH "", " ", " ", " ", " ", " ", " ",
05500 " ", " ", " ", " " ;
05600 SAFE STRING ARRAY SPSARR[0:10] ;
05700
05800 INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ; IF N≤10 THEN RETURN(SPSARR[N MAX 0])
05900 ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
06000 ELSE BEGIN
06100 STRING S ; INTEGER I ;
06200 S ← SPSARR[10] ;
06300 FOR I ← 11 THRU N DO S ← S & SP ;
06400 RETURN(S) ;
06500 END ;
00100 COMMENT I N I T I A L I Z E ;
00110 IFC VERSION=PARCVER THENC
00120 DUMMY←CVSIX("PUB2 ");
00130 START!CODE
00140 MOVE 1,DUMMY;
00150 '104000000210;
00160 END;
00170 ENDC
00180
00200 SCRIPT ← 10;
00250 IFC TENEX THENC JOBNO ← GJINF(DUMMY, DUMMY, DUMMY) ; ENDC TES 10/25/73 ;
00300
00400 OUTSTR("PASS TWO: ") ;
00410 IFC VERSION=PARCVER THENC IML←65; IMC←72; ENDC
00420 IFC VERSION=SAILVER THENC IML←53; IMC←69; ENDC
00430 IFC VERSION=CMUVER THENC IML←55; IMC←69; ENDC
00500 PAGEHIGH ← PAGEWIDE ← PAGECT ← 0 ; CRLF ← CR & LF ;
00600 SETBREAK(ONE_CHAR, NULL, NULL, "XA") ;
00700 SETBREAK(TO_ALTMODE_SKIP, ALTMODE, NULL, "IS") ;
00800 SETBREAK(TO_LF_APPD, LF, NULL, "IA") ;
00900 SETBREAK(BREAKER, RUBOUT&VT&ALTMODE&CR&LF, NULL, "IS") ;
01000 SETBREAK(TO_RUB_ALT_SKIP, RUBOUT&ALTMODE, NULL, "IS") ;
01100 SEQCHAN ← READIN("PUPSEQ.PUI", FALSE, SEQBRC, SEQEOF) ;
01200 TMPFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
01300 LISTFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
01400 DEBUG ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)) ;
01500 DEVICE ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)) ;
01600 DELINT ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
01650 BAR ← INPUT(SEQCHAN, TO_ALTMODE_SKIP)[1 FOR 1] ;
01675 IF BAR = SP THEN BAR ← 0 ; TES 10/22/73 ;
01700 CHARW ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP));
01800 IFC VERSION=SAILVER THENC LFTMAR←CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP));
01900 BASELINE←CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)); BASELINE←BASELINE+(BASELINE DIV 4); ENDC
02000 IF ¬RPGSW AND DEVICE ≠ XGP THEN COMMENT STARTED BY ".R PUB2" ;
02100 DO BEGIN
02200 OUTSTR("OUTPUT DEVICE (LPT, TTY or MIC): ") ;
02300 S ← INCHWL ;
02400 DEVICE ← IF ANS(L) THEN LPT ELSE IF ANS(T) THEN TTY ELSE
02500 IF ANS(M) THEN MIC ELSE IF ANS(X) THEN XGP ELSE 0;
02600 END
02700 UNTIL DEVICE ;
02800 IF ¬RPGSW AND DEBUG THEN
02900 IF DEVICE = MIC THEN DEBUG ← 0
03000 ELSE DO BEGIN
03100 OUTSTR("DEBUG INFO IN RIGHT MARGIN? (Y or N) = ") ;
03200 S ← INCHWL ;
03300 DEBUG ← IF ANS(Y) THEN -1 ELSE IF ANS(N) THEN 0 ELSE 100 ;
03400 END
03500 UNTIL DEBUG < 100 ;
03600 OUTSTR(LISTFILE & " ") ;
03700 ENDLINE ← LF ; ENDPAGE ← FF ;
03750 RESTARTLINE ←
03775 IFC PARCVER THENC IF DEVICE=XGP THEN CTLT&"0." ELSE CR
03787 ELSEC CR ENDC ; TES 11/1/73 ;
03800 CASE DEVICE-1 OF
03900 BEGIN "DEV"
04000 comment 1...LPT ; LISTCHAN ← WRITEON(LISTFILE) ;
04100 comment 2...TTY ; LISTCHAN ← WRITEON(LISTFILE) ;
04200 comment 3...MIC ; BEGIN IML ← IMC ← 1 ; LISTCHAN ← WRITEON(TMPFILE) ;
04300 IF DEBUG THEN BEGIN WARN("Won't put Debug info on Microfilm") ;
04400 DEBUG ← FALSE ; END END ;
04500 COMMENT 4...XGP ; LISTCHAN ← WRITEON(LISTFILE)
04600 END "DEV" ;
04700 J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;
04800 LABCHAN ← READIN("PULABL.PUI", FALSE, LABBRC, LABEOF) ;
04900 NL ← CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP)) ;
05000 LASL ← 1000 ; comment, last physical line occupied on the page ;
05100 S←INPUT(SEQCHAN,TO_LF_APPD); comment get to right place ;
00100 BEGIN "INNER BLOCK"
00200
00300 STRING ARRAY LABTAB[0:1, 0:NL], OWLS[0:FIML-1] ;
00400
00500 AWHILE DO
00600 BEGIN "LABEL"
00700 TABLE ← CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP)) ; IF LABEOF THEN DONE ;
00800 LABTAB[TABLE, CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP))] ←
00900 INPUT(LABCHAN, TO_ALTMODE_SKIP) &
01000 (IF DEVICE = XGP THEN
01100 (ALTMODE & INPUT(LABCHAN, TO_ALTMODE_SKIP))
01200 ELSE NULL);
01300 END "LABEL" ;
01400
01500 RELEASE(LABCHAN);
01600
01700 COMMENT G O ! ;
01800 DO comment, This loop is re-entered only if page image grows ;
01900 BEGIN "SIZE"
02000 SAFE STRING ARRAY IMG[1:IML+IML], SEG[0:IMC+IMC], SRCREF[1:IML] ;
02100 SAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML] ;
02200 LABEL CONTINUE ;
02300
02400 INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
02500 BEGIN "APPD"
02600 INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
02700 L ← LINE ; EXTRA ← LENGTH(S) ;
02705 IFC VERSION NEQ CMUVER THENC
02710 IF DEVICE=XGP THEN
02715 BEGIN TES 11/13/73 FOR MULTI-COLUMNS ;
02717 IF CHAR < (HAD ← LASC[L]) THEN
02719 BEGIN
02720 FAKE[L] ← FAKE[L] + HAD - CHAR ;
02725 HAD ← LASC[L] ← CHAR ;
02730 END
02735 END
02740 ELSE
02745 ENDC
02800 WHILE CHAR < (HAD ← LASC[L]) DO IF (F←LINK[L]) THEN L ← F ELSE
02900 IF (LINK[L] ← AVAIL←AVAIL+1) > IML+IML THEN WARN("TOO MUCH FOR 1 PAGE: " & S)
03000 ELSE L ← AVAIL ;
03100 T ← IMG[L] ; SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[L] ;
03200 IF LENGTH(T) < HAD+SPACES+EXTRA THEN BEGIN comment no room -- must use concatenate ;
03300 SS ← SPS(SPACES) ; IF DEVICE=MIC THEN FAKE[L] ← FAKE[L] + LENGTH(SS) - SPACES ;
03400 IMG[L] ← IF HAD THEN T[1 TO HAD]&SS&S ELSE (0&SS&S)[2 TO ∞] END
03500 ELSE BEGIN comment there's room in old string -- IDPB into it.;
03600 SS ← T[HAD + 1 FOR 1] ; comment byte pointer to IDPB place ;
03700 START_CODE "APPEND" LABEL LOOP1, LOOP2 ;
03800 MOVE 1, SS ; MOVE 2, S ; MOVE 3, EXTRA ;
03900 MOVE 4, SPACES ; JUMPE 4, LOOP2 ; MOVEI 5, '40 ; LOOP1: IDPB 5,1 ; SOJG 4,LOOP1 ;
04000 LOOP2: ILDB 5, 2 ; IDPB 5, 1 ; SOJG 3, LOOP2 ;
04100 END "APPEND" ;
04200 END ;
04300 RETURN(LASC[L] ← CHAR + EXTRA) ;
04400 END "APPD" ;
04500
04600 SIMPLE PROCEDURE CTRL(STRING S) ;
04700 BEGIN "CTRL"
04800 CHAR ← APPD(S) - LENGTH(S) ;
04900 LASC[L] ← CHAR ;
05000 FAKE[L] ← FAKE[L] + LENGTH(S) ;
05100 END "CTRL" ;
00100 SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) ;
00200 BEGIN "UNDERSCORE"
00300 INTEGER NUMCHARS, DESCEND, SAVEHORIZ ;
00400 NUMCHARS ← RIGHTCHAR - UNDERLINE ;
00500 IF NUMCHARS > 0 THEN
00600 BEGIN
00700 SAVEHORIZ ← CHORIZ ;
00800 DESCEND ← CCSIZE DIV 4 ;
00900 CTRL( DOLSPCS(CHAR-UNDERLINE) & DOUDOTS(-DESCEND) & DOULINE(NUMCHARS-1) &
01000 SETHORIZ(CCSIZE) & DOULINE(1) & DOLSPCS(1) & SETHORIZ(SAVEHORIZ) &
01100 DOUDOTS(DESCEND) & DORSPCS(CHAR - RIGHTCHAR + 1) ) ;
01200 UNDERLINE ← RIGHTCHAR ;
01300 END ;
01400 END "UNDERSCORE" ;
01500
01600 SIMPLE PROCEDURE CHANGESPACING ;
01700 IF (N←CHRS-CHAR-1)>0 ∧ (K←(J←N*CHORIZ+SHORTM)/N MIN 511)≠CHORIZ THEN
01800 BEGIN "CHANGESPACING"
01900 IF UNDERLINE≥0 THEN UNDERSCORE(CHAR) ;
02000 SHORTM ← J - K*N ;
02100 IF NOTFST ∧ (UNDERLINE<0 ∨ SHORTM<0) THEN
02200 BEGIN DORDOTS(SHORTM) ; SHORTM ← 0 END ;
02300 CTRL(SETHORIZ(K)) ; NOTFST ← TRUE ;
02400 END "CHANGESPACING" ;
02500
02600 SIMPLE PROCEDURE FONTSELECT(INTEGER WHICH);
02700 BEGIN "FONTSELECT"
02800 IF (WHICH←WHICH-"0")>9 THEN WHICH←WHICH-("A"-"0"-10);
02900 IFC VERSION=CMUVER THENC
03000 IF WHICH=10 THEN CTRL(USEA) ELSE
03100 IF WHICH=11 THEN CTRL(USEB) ELSE
03200 WARN("Font ignored")
03300 ELSEC IFC VERSION=SAILVER THENC
03400 IF WHICH>16 THEN WARN("Font ignored") ELSE
03500 BEGIN
03600 CTRL(ESCAPE1&(WHICH-1));
03700 IF SCRLVL THEN CTRL(ESCAPE1&'43&SCRLVL);
03800 END;
03900 ELSEC IFC VERSION=PARCVER THENC
04000 IF WHICH>9 THEN WARN("Font ignored") ELSE
04100 CTRL(6&(THISFONT←WHICH+"0"))
04200 ENDC ENDC ENDC;
04300 END "FONTSELECT";
04400
04500 SIMPLE PROCEDURE XGPTAB(INTEGER N);
04600 BEGIN "XGPTAB"
04640 IFC VERSION NEQ CMUVER THENC
04680 N ← N + TLFTMAR ; TVR: used to be LFTMAR; ENDC
04700 IFC VERSION=CMUVER THENC CTRL(XTAB&XGPNUM(N)) ENDC
04800 IFC VERSION=SAILVER THENC
05000 CTRL(ESCAPE1&'40&XGPNUM(N))
05100 ENDC
05200 IFC VERSION=PARCVER THEN
05300 CTRL(CTLT&CVS(N)&".")
05400 ENDC;
05500 END "XGPTAB";
00100 SIMPLE PROCEDURE RIGHTBOUND ;
00200 BEGIN "RIGHTBOUND" COMMENT RIGHT BOUND OF ∞ ;
00300 INTEGER DEST, FILLIN, I ; STRING FILLER, OLBF ;
00400 INTEGER XF;
00500 IF SLIDETOP < 1 THEN BEGIN IMPOSSIBLE("SLIDETOP1") ; SLIDETOP ← 1 END ;
00600 IF LBD[SLIDETOP] < -900 THEN COMMENT FLUSH RIGHT ;
00700 BEGIN
00800 IF DEVICE = XGP THEN XF←RB[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE);
00900 FILLIN←RB[SLIDETOP]-CHRS;
01000 END
01100 ELSE COMMENT CENTER ;
01200 BEGIN
01300 IF DEVICE = XGP THEN
01400 XF ← (RB[SLIDETOP]-LBD[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE)) DIV 2;
01500 FILLIN ← (((RB[SLIDETOP]-CHRS) - LBD[SLIDETOP]) DIV 2) MAX 0;
01600 END;
01700 DEST ← CHRS + FILLIN ; OLBF ← LBF[SLIDETOP] ;
01800 IF FULSTR(OLBF) THEN
01805 IF DEVICE=XGP THEN
01810 BEGIN "XGPINFINITY"
01815 FILLER ← NULL ;
01820 FOR I ← 1 THRU XINF[SLIDETOP] DO FILLER ← FILLER & OLBF ;
01825 SEG[I ← SLIDESG[SLIDETOP]] ← FILLER ;
01830 SEG[I + 1] ← RUBOUT & "=" & CVS(XF) ;
01835 END "XGPINFINITY"
01840 ELSE
01900 BEGIN "NON-BLANKS"
02000 FILLER ← NULL ;
02100 WHILE CHRS < DEST DO
02200 BEGIN
02300 FILLER ← FILLER & OLBF ;
02400 CHRS ← CHRS + LENGTH(OLBF) ;
02500 END ;
02600 IF CHRS > DEST THEN FILLER ← FILLER[1 TO ∞-(CHRS-DEST)] ;
02700 SEG[SLIDESG[SLIDETOP]] ← FILLER ;
02800 END "NON-BLANKS"
02900 ELSE SEG[SLIDESG[SLIDETOP]] ← RUBOUT &
03000 (IF DEVICE = XGP THEN ("="&CVS(XF))
03100 ELSE ("+"&CVS(FILLIN)) );
03200 CHRS ← DEST ; SLIDETOP ← SLIDETOP - 1 ;
03300 BRKS ← 0 ; FSTCHRS ← CHRS ; FSTBRK ← SG ; COMMENT NOJUST TO LEFT ;
03400 FLUSHING ← FALSE ; FSIZE ← 0 ;
03500 END "RIGHTBOUND";
00100 IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
00200 AWHILE DO
00300 BEGIN "FILE"
00400 PAGEFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ; IF SEQEOF THEN DONE ;
00500 IFILE ← PAGEFILE & ".PUI" ; SFILE ← PAGEFILE & "S.PUI" ;
00600 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
00700
00800 AWHILE DO
00900 BEGIN "PAGE"
01000 PAGEHIGH ← INNUM ; IF PAGEEOF ∨ PAGEHIGH≤0 THEN DONE ; PAGEWIDE ← INNUM ;
01100 IF PAGEHIGH > IML ∨ PAGEWIDE > IMC THEN
01200 BEGIN "EXPAND"
01300 IF DEVICE=MIC THEN
01400 BEGIN "FRAME SIZE"
01500 IF LASL ≠ 1000 THEN OUT(LISTCHAN, ENDPAGE) ;
01600 NVERTI ← 11000 DIV PAGEHIGH MIN 16384 DIV PAGEWIDE MIN 375 ;
01700 NHORIZ ← 10*NVERTI DIV 11 ; NCSIZE ← (9*NHORIZ DIV 80)*8 ;
01800 OUT(LISTCHAN, SETSIZE(NCSIZE)&SETHORIZ(NHORIZ)&SETVERTI(NVERTI)) ;
01900 END "FRAME SIZE"
02000 IFC VERSION=SAILVER THENC
02100 ELSE IF DEVICE = LPT THEN
02200 BEGIN
02300 IF (LASL-1) MOD 66 + 1 ≤ 6 ∧ (PAGEHIGH-1) MOD 66 < 60 THEN
02400 OUT(LISTCHAN, ENDPAGE) ;
02500 ENDLINE ← IF PAGEHIGH≥54 THEN RUBOUT & '21 ELSE LF ;
02600 END ;
02700 ENDC;
02800 IML ← PAGEHIGH ; IMC ← PAGEWIDE ;
02900 DONE ; comment, Exit "SIZE" block and immediately reenter with bigger IMG array ;
03000 END "EXPAND" ;
03100
03200 CONTINUE: OUTSTR(CVS(PAGECT ← PAGECT + 1) & SP) ; AVAIL ← IML ;
03300 IFC VERSION=SAILVER THENC
03400 IF DEVICE = LPT AND PAGECT ≠ 1 THEN COMMENT AVOID SPURIOUS BLANK PAGE ;
03500 IF (IML-1) MOD 66 < 60 THEN OUT(LISTCHAN, ENDPAGE)
03600 ELSE FOR L ← (LASL-1) MOD 66 + 2 THRU 66 DO
03700 BEGIN OUT(LISTCHAN, CR) ; OUT(LISTCHAN, ENDLINE) END ;
03800 ENDC
00100 WHILE (TOPLINE ← INNUM) > -10 DO
00200 BEGIN "AREA"
00300 NCOLS ← INNUM ; NLINES ← INNUM ;
00400 FOR COL ← 1 THRU NCOLS DO
00500 BEGIN "COLUMN"
00600 LEFTCH ← INNUM ;
00640 IFC VERSION NEQ CMUVER THENC
00680 TLFTMAR ← LFTMAR + CHARW*(LEFTCH-1) ;
00690 ENDC TVR: Initiallize left margin for this column ;
00700 WHILE (LINENO ← INNUM) DO
00800 BEGIN "LINE"
00900 SH ← SHORTM ← INNUM ; SG ← FSTBRK ← -1 ; BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
01000 LINE ← TOPLINE - 1 + LINENO ;
01100 IF LINE<1∨LINE>IML THEN BEGIN WARN("Area outside page"); LINE←LINE MAX 1 MIN IML END ;
01200 L ← INNUM ; F ← L MOD FIML ; OWL ← OWLS[F] ;
01300 IF FULSTR(OWL) THEN BEGIN FROMFILE ← FALSE ; OWLS[F] ← NULL END
01400 ELSE BEGIN FROMFILE ← TRUE ;
01500 WHILE L ≠ (M←CVD(INP(TO_ALTMODE_SKIP))) DO
01600 BEGIN S ← NULL ;
01700 DO S ← S & INP(TO_LF_APPD) UNTIL PAGEBRC = LF ;
01800 OWLS[M MOD FIML] ← S ;
01900 END ;
02000 END ;
02100 IF ¬DEBUG THEN S ← SCN(TO_ALTMODE_SKIP)
02200 ELSE BEGIN
02300 SRCREF[LINE] ← SRCREF[LINE] & " " & SCN(TO_RUB_ALT_SKIP) ;
02400 WHILE PAGEBRC ≠ ALTMODE DO
02500 BEGIN "ERROR MESSG"
02600 S ← SCN(TO_RUB_ALT_SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
02700 IF DEVICE=TTY ∨ (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SRCREF[L])+M ≤ 119 THEN
02800 SRCREF[L] ← SRCREF[L] & "..." & S ;
02900 END "ERROR MESSG" ;
03000 END ;
03100 DO BEGIN "PIECE"
03200 CHRS ← CHRS + LENGTH(SEG[SG ← SG + 1] ← SCN(BREAKER)) ;
00100 CASE CHARTBL[PAGEBRC] OF
00200 BEGIN comment by BRC ;
00300
00400 comment 0 ... ; IMPOSSIBLE("BREAKER") ;
00500
00600 comment 1 ... RUBOUT -- Font change ; BEGIN
00700 SEG[SG←SG+1] ← RUBOUT & (F←SCN(ONE_CHAR)) &
00800 (S ← IF F="-" ∨ F="+" ∨ F="=" THEN SCN(TO_ALTMODE_SKIP)
00900 ELSE IF F = "π" OR F = "F" THEN SCN(ONE_CHAR) ELSE NULL) ;
01000 IF F = "π" THEN CHRS ← CHRS + 1
01100 ELSE IF F = "+" THEN CHRS ← CHRS + CVD(S)
01200 ELSE IF F = "-" THEN CHRS ← CHRS - CVD(S)
01300 ELSE IF F = "→" THEN
01400 BEGIN COMMENT ∞ ;
01500 IF (SLIDETOP ← SLIDETOP + 1) > 5 THEN IMPOSSIBLE("SLIDETOP") ;
01600 SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
01700 LBD[SLIDETOP] ← SCNUM ;
01800 IF DEVICE = XGP THEN
01805 BEGIN
01810 RKJ; XFILL[SLIDETOP] ← SCNUM ;
01815 TES ; XINF[SLIDETOP] ← SCNUM ;
01820 END ;
01900 LBF[SLIDETOP] ← SCN(TO_ALTMODE_SKIP) ;
02000 FLUSHING ← TRUE;
02100 END
02200 ELSE IF F = "←" THEN
02300 RIGHTBOUND
02400 ELSE IF F = "=" THEN BEGIN
02500 comment 8/9/73 RKJ IF DEVICE=XGP THEN SHORTM←(SHORTM-BRKS*CHARW) MAX 0;
02600 BRKS←0 ; FSTCHRS←CHRS←CVD(S) ; FSTBRK←SG END ;
02700 END ; COMMENT NOJUST LEFT OF TAB ;
02800
02900 comment 2 ... ALTMODE -- Word Break ; BEGIN BRKS ← BRKS + 1 ; SEG[SG←SG+1] ← ALTMODE END ;
03000
03100 comment 3 ... VT -- label reference ;
03200 BEGIN "LABEL REF"
03300 STRING S;
03400 S ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ;
03500 L ← LENGTH(SEG[SG←SG+1] ← SCAN(S, TO_ALTMODE_SKIP, DUMMY)) ;
03600 J ← CVD(S) ;
03700 SHORTM ← SHORTM - (IF DEVICE=XGP THEN J ELSE L) ; CHRS ← CHRS + L ;
03800 IF FLUSHING AND DEVICE=XGP THEN FSIZE←FSIZE+J ;
03900 END "LABEL REF" ;
00100 comment 4 ... CR -- Justify it ;
00200 BEGIN "JUSTIFY"
00300 WHILE SLIDETOP DO BEGIN IMPOSSIBLE("SLIDE TOP") ; RIGHTBOUND END ;
00400 IF SHORTM < 0 THEN SHORTM ← 0 ;
00500 IF DEVICE = MIC THEN SHORTM ← SHORTM*NHORIZ
00600 ELSE BEGIN "DISTRIBUTE SPACES"
00700 COMMENT β(α,K) = [α(K+1)] - [αK],
00800 WHERE α = SHORTM/BRKS, is h.m. spaces to insert at the K'th break ;
00900 RATIO ← IF BRKS=0 THEN 0.0 ELSE SHORTM/BRKS ; TERM ← RATIO + .0001 ; BRKS ← 1 ;
01000 END "DISTRIBUTE SPACES" ;
01100 UNDERLINE←-1 ; LINE←TOPLINE-1+LINENO MAX 1 MIN IML ; CHAR←LEFTCH-1 MAX 0 ;
01200 NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;
01220
01240 TVR: Initial column select for XGP ;
01260 IFC VERSION NEQ CMUVER THENC IF DEVICE=XGP AND LEFTCH NEQ 1 THEN XGPTAB(0) ELSE ENDC
01280
01300 IF DEVICE = MIC AND FSTBRK = -1 THEN CHANGESPACING ;
01400 FOR G ← 0 THRU SG DO IF FULSTR(S ← SEG[G]) THEN CASE CHARTBL[S] OF
01500 BEGIN comment three cases ;
01600
01700 comment 0 ... text ;
01800 BEGIN "TEXT SEG"
01900 IF UNDERLINE<0 OR BAR=0 TES 10/22/73 ; THEN CHAR←APPD(S) ELSE
02000 IF DEVICE = MIC THEN
02100 BEGIN K ← LENGTH(S) ;
02200 WHILE K DO
02300 BEGIN COMMENT DON'T UNDERLINE BLANKS ;
02400 N ← LOP(S) ;
02500 IF N=SP THEN BEGIN UNDERSCORE(CHAR-K) ; UNDERLINE←UNDERLINE+1 END ;
02600 K ← K - 1 ;
02700 END ;
02800 END
02900 ELSE IF DEVICE = XGP THEN
03000 BEGIN
03100 IFC VERSION=CMUVER THENC
03200 K←LENGTH(S); SS←0&SPS(K*4); N←LOP(SS);
03300 START!CODE "XGPUNDER"
03400 DEFINE LEN="2",SRC="3",DEST="4",RUB="5",ESC="6",R="7",CNT="'10",UBAR="'11";
03500 LABEL LOOP,ELOOP,SPACE,OUTT;
03600 SETZ CNT,0; MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI RUB,'177; MOVEI ESC,'35; MOVE UBAR,BAR;
03700 LOOP: ILDB R,SRC;
03800 CAIE R,BAR; CAIN R,SP; JRST SPACE;
03900 IDPB RUB,DEST; IDPB ESC,DEST; IDPB R,DEST; IDPB UBAR,DEST;
04000 ELOOP: SOJG LEN,LOOP;
04100 MOVEM CNT,N; JRST OUTT;
04200 SPACE: IDPB R,DEST;
04300 AOJA CNT,ELOOP;
04400 OUTT:
04500 END "XGPUNDER";
04600 CHAR←APPD(SS[1 TO (K*4-N*3)])-(K-N)*3;
04700 LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*3;
04800 ENDC
04900 IFC VERSION=SAILVER THENC CHAR←APPD(S); ENDC
05000 IFC VERSION=PARCVER THENC
05100 K←LENGTH(S); SS←0&SPS(K*3); N←LOP(SS);
05200 START!CODE "XGPUNDER"
05300 DEFINE LEN="2",SRC="3",DEST="4",BS="5",UBAR="6",CNT="7",R="'10";
05400 LABEL LOOP, OUTT;
05500 SETZ CNT,0;
05600 MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI BS,'10; MOVE UBAR,BAR;
05700 LOOP: SOJL LEN,OUTT;
05800 ILDB R,SRC;
05900 IDPB R,DEST;
06000 CAIE R,BAR; CAIN R,SP; AOJA CNT,LOOP;
06100 IDPB BS,DEST; IDPB UBAR,DEST;
06200 JUMPA LOOP;
06300 OUTT: MOVEM CNT,N;
06400 END "XGPUNDER";
06500 CHAR←APPD(SS[1 TO (K*3-N*2)])-(K-N)*2;
06600 LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*2;
06700 ENDC
06800 END
00100 ELSE BEGIN CHAR ← APPD(S);
00200 K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR←CHAR-K ;
00300 START_CODE "UNDER" LABEL LOOP ;
00400 MOVE 2, K ; MOVE 3, SS ;
00500 LOOP: ILDB 4,3 ; CAIE 4,SP ; CAIN 4,BAR ; CAIA 0,0 ; MOVE 4,BAR ; DPB 4,3 ; SOJG 2,LOOP ;
00600 END "UNDER" ; CHAR ← APPD(SS[1 TO LENGTH(S)]) ;
00700 END ;
00800 END "TEXT SEG" ;
00900
01000 comment 1 ... RUBOUT -- Font Change ;
01100 IF (F←S[2 FOR 1])="↑" THEN
01200 IF DEVICE=MIC THEN CTRL(DOUDOTS(CCSIZE MIN 63)) ELSE
01300 IFC VERSION=PARCVER THENC
01400 IF DEVICE=XGP THEN
01500 IF (SCRLVL←SCRLVL+SCRIPT)≤0 THEN CTRL("R"-'100) ELSE
01600 BEGIN LABEL L1;
01700 CTRL("U"-'100);
01750 L1:
01800 IF G<SG THEN
01900 BEGIN
02000 SS←SEG[G+1];
02050 IF NULSTR(SS) THEN BEGIN G←G+1; GO L1 END; comment try again ;
02100 IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
02200 BEGIN
02300 G←G+1;
02400 CTRL(SS[3 FOR 1]);
02500 END ELSE CTRL(THISFONT);
02600 END ELSE CTRL(THISFONT)
02700 END
02800 ELSE ENDC
02900 IFC VERSION=SAILVER THENC
03000 IF DEVICE=XGP THEN
03100 CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL+SCRIPT))
03200 ELSE ENDC LINE←LINE-1 MAX 1
03300 ELSE IF F = "↓" THEN
03400 IF DEVICE=MIC THEN CTRL(DOUDOTS(-(CCSIZE MIN 63))) ELSE
03500 IFC VERSION=PARCVER THENC
03600 IF DEVICE=XGP THEN
03700 IF (SCRLVL←SCRLVL-SCRIPT)≥0 THEN CTRL("R"-'100) ELSE
03800 BEGIN LABEL L2;
03900 CTRL("S"-'100);
03950 L2:
04000 IF G<SG THEN
04100 BEGIN
04200 SS←SEG[G+1];
04250 IF NULSTR(SS) THEN BEGIN G←G+1; GO L2 END; comment ↑↑↑ ;
04300 IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
04400 BEGIN
04500 G←G+1;
04600 CTRL(SS[3 FOR 1]);
04700 END ELSE CTRL(THISFONT);
04800 END ELSE CTRL(THISFONT)
04900 END
05000 ELSE ENDC
05100 IFC VERSION=SAILVER THENC
05200 IF DEVICE=XGP THEN
05300 CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL-SCRIPT)) ELSE ENDC LINE←LINE+1 MIN IML
05400 ELSE IF F = "_" THEN
05500 BEGIN
05600 UNDERLINE ← CHAR;
05700 IFC VERSION=SAILVER THENC
05800 IF DEVICE=XGP THEN CTRL(ESCAPE1&'46);
05900 ENDC
06000 END
06100 ELSE IF F = "≡" THEN
06200 BEGIN "END UNDERLINED TEXT"
06300 IF DEVICE = MIC AND BAR TES 10/22/73; THEN UNDERSCORE(CHAR) ;
06400 UNDERLINE ← -1 ;
06500 IFC VERSION=SAILVER THENC
06600 IF DEVICE=XGP AND BAR TES 10/22/73; THEN CTRL(ESCAPE1&'47&BASELINE);
06700 ENDC
06800 END "END UNDERLINED TEXT"
06900 ELSE IF F="-" THEN
07000 IF DEVICE=MIC THEN CTRL(DOLSPCS(CVD(S[3 TO ∞])))
07100 ELSE CHAR←CHAR-CVD(S[3 TO ∞]) MAX 0
07200 ELSE IF F="*" THEN CHAR ← LASC[LINE] comment not always correct! ;
07300 ELSE IF F="+" THEN
07400 IF DEVICE=MIC THEN CTRL(DORSPCS(CVD(S[3 TO ∞])))
07500 ELSE IF DEVICE=XGP THEN CTRL(VARBLANK(CVD(S[3 TO ∞])))
07600 ELSE CHAR←CHAR+CVD(S[3 TO ∞]) MIN IMC
07700 ELSE IF F="=" THEN
07800 BEGIN "TAB"
07900 F ← CVD(S[3 TO ∞]) ;
08000 IF DEVICE ≠ XGP THEN F ← F + LEFTCH - 1 MIN IMC MAX 1 ;
08100 IF DEVICE = XGP THEN XGPTAB(F)
08200 ELSE IF DEVICE ≠ MIC THEN CHAR ← F
08300 ELSE IF F < CHAR THEN DOLSPCS(CHAR - F)
08400 ELSE IF F > CHAR THEN DORSPCS(F - CHAR) ;
08500 END "TAB"
08600 ELSE IF F = "π" THEN
08700 BEGIN F←S[∞ FOR 1] ;
08900 IF DEVICE = TTY THEN CHAR ← APPD(F)
09000 ELSE BEGIN
09010 IFC VERSION=CMUVER THENC
09020 DEFINE S1="'34",
09030 K1="(IF DEVICE=XGP THEN 2 ELSE 1)",
09040 K2="(IF DEVICE=XGP THEN 1 ELSE 2)";
09050 ELSEC DEFINE S1="NULL",K1="1",K2="1";
09060 ENDC
09070 CHAR←APPD(RUBOUT&S1&(
09100 IF F="." THEN '0 ELSE IF F="G" THEN '11 ELSE IF F="∂" THEN '12 ELSE IF F
09200 ="~" THEN '13 ELSE IF F="-" THEN '14 ELSE IF F="+" THEN '15 ELSE 0))-K1 ;
09300 LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + K2 ; END ;
09400 IF UNDERLINE≥0 ∧ DEVICE≠MIC THEN BEGIN CHAR←CHAR-1; CHAR←APPD(BAR) END ;
09500 END
09600 ELSE IF F = "←" THEN BEGIN END
00100 ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
00200 ELSE IF F='35 THEN COMMENT OVERSTRIKE NEXT CHAR OVER LAST ;
00300 BEGIN "OVERSTRIKE"
00400 IFC VERSION=CMUVER THENC
00500 INTEGER Q;
00600 Q←IMG[L][(LASC[L]+FAKE[L]) FOR 1];
00700 LASC[L]←LASC[L]-1; CHAR←CHAR-1;
00800 CTRL(RUBOUT&'35); CHAR←APPD(Q);
00900 ENDC
01000 IFC VERSION=SAILVER THENC IMPOSSIBLE("Overstrike") ENDC
01100 IFC VERSION=PARCVER THENC
01200 CTRL('10)
01300 ENDC
01400 END
01500 ELSE IF F=RUBOUT THEN IF DEVICE≠XGP THEN CHAR←APPD(SP) ELSE
01600 BEGIN
01700 CHAR←APPD(RUBOUT&RUBOUT)-1; LASC[L]←CHAR; FAKE[L]←FAKE[L]+1;
01800 END
01900 ELSE IMPOSSIBLE("FONT `"&F&"'") ;
02000
02100 comment 2 ... ALTMODE -- word break ;
02200 IF SHORTM ∧ G > FSTBRK THEN
02300 IF DEVICE ≠ MIC THEN
02400 BEGIN "SPREAD"
02500 TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
02600 IF DEVICE = XGP THEN
02700 BEGIN "DOVSB"
02800 CTRL(VARBLANK((TERMX-TERM) MIN SHORTM));
02900 SHORTM←(SHORTM-TERMX+TERM) MAX 0;
03000 END "DOVSB"
03100 ELSE CHAR ← CHAR + TERMX - TERM MIN IMC ;
03200 TERM ← TERMX ;
03300 END "SPREAD"
03400 ELSE CHANGESPACING
03500 ELSE IF SHORTM AND DEVICE=XGP THEN
03600 BEGIN
03700 CHAR←APPD(SP);
03800 END;
03900
04000 comment 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
04100 END ; COMMENT three cases ;
04200 IF CHORIZ ≠ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ;
04300 IFC VERSION=SAILVER THENC
04400 IF DEVICE=XGP AND UNDERLINE≥0 THEN
04500 CTRL(ESCAPE1&'47&BASELINE);
04600 ENDC
04700 BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
04800 END "JUSTIFY" ;
00100 comment 5 ... LF ; BEGIN END ;
00200 END ; comment, by BRC ;
00300 END "PIECE"
00400 UNTIL PAGEBRC = LF ;
00500 END "LINE" ;
00600 END "COLUMN" ;
00700 END "AREA" ;
00800
00900 FOR LASL ← PAGEHIGH DOWN 1 DO IF LASC[LASL] THEN DONE ;
01000
01100 F ← 120 - (IMC MAX 78) ;
01200 FOR N ← 1 THRU LASL DO
01300 BEGIN "LIST LINE"
01400 L ← N ; IF DEBUG ∧ LENGTH(S←SRCREF[L])>F ∧ DEVICE=LPT THEN S←S[1 TO F] ;
01500 NEEDCR ← FALSE ; TES 11/1/73 ;
01600 DO BEGIN "PART LINE"
01700 IF M ← LASC[L] THEN
01800 BEGIN "NONBLANK"
01850 IF NEEDCR THEN OUT(LISTCHAN, RESTARTLINE) ELSE NEEDCR ← TRUE ; TES 11/1/73;
01900 OUT(LISTCHAN, IMG[L][1 TO M+FAKE[L]]) ;
02000 IF DEBUG ∧ L=N THEN OUT(LISTCHAN, SPS((IMC MAX 80)-M) & S);
02200 END "NONBLANK" ;
02300 M ← L ; L ← LINK[M] ; LINK[M] ← LASC[M] ← FAKE[M] ← 0 ;
02400 END "PART LINE" UNTIL L=0 ;
02500 TES 11/1/73 CHANGED ; OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;
02600 OUT(LISTCHAN, ENDLINE) ;
02700 IF DEBUG THEN SRCREF[N] ← NULL ;
02800 END "LIST LINE" ;
02900
03000 IFC VERSION=SAILVER THENC IF DEVICE ≠ LPT THEN ENDC OUT(LISTCHAN, ENDPAGE) ;
03100
03200 END "PAGE" ;
03300
03400 IF ¬(PAGEEOF ∨ PAGEHIGH≤0) THEN DONE ; comment expand IMG ;
03500 RELEASE(ICHAN) ; RELEASE(SCHAN) ;
03600 END "FILE" ;
03700
03800 END "SIZE" UNTIL SEQEOF ;
03900
04000 IFC VERSION=SAILVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
04100
04200 RELEASE(LISTCHAN) ; RELEASE(SEQCHAN) ;
04300 END "INNER BLOCK" ;
00100 BEGIN EXTERNAL SIMPLE PROCEDURE K_OUT ; K_OUT END ; COMMENT ** ** ** ** ** ;
00200
00300 OUTSTR(CRLF) ; comment signal terminal that pass two is done ;
00400 IF DELINT="A" ∨ DELINT="a" THEN
00500 BEGIN
00600 OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
00700 DELINT ← INCHWL ;
00800 END ;
00900 IF DELINT="Y" ∨ DELINT="y" THEN
01000 BEGIN "DELETE INTERMEDIATE FILES"
01100 SEQCHAN ← READIN("PUPSEQ.PUI", FALSE, SEQBRC, SEQEOF) ;
01200 DO INPUT(SEQCHAN, TO_LF_APPD) UNTIL SEQBRC=LF;
01300 LABCHAN ← READIN("PULABL.PUI", FALSE, LABBRC, LABEOF) ;
01400 RENAME(LABCHAN, NULL, 0, I) ; COMMENT DELETE ;
01500 RELEASE(LABCHAN);
01600 AWHILE DO
01700 BEGIN
01800 PAGEFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
01900 IF SEQEOF THEN DONE ;
02000 IFILE ← PAGEFILE & ".PUI" ; SFILE ← PAGEFILE & "S.PUI" ;
02100 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ;
02200 SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
02300 RENAME(ICHAN, NULL, 0, I) ; RENAME(SCHAN, NULL, 0, I) ;
02400 RELEASE(ICHAN); RELEASE(SCHAN);
02500 END ;
02600 RENAME(SEQCHAN, NULL, 0, I) ; RELEASE(SEQCHAN) ;
02700 END "DELETE INTERMEDIATE FILES"
02800 ELSE IF DELINT≠"N" ∧ DELINT≠"n" THEN WARN(DELINT&"? -- .PUI FILES WERE NOT DELETED") ;
02900
03000 IFC VERSION=SAILVER THENC
03100 IF DEVICE = MIC THEN
03200 BEGIN "PASS 3"
03300 INTEGER FCHAN ;
03400 INTEGER SIMPLE PROCEDURE CORELOC(INTEGER ARRAY A) ; START_CODE MOVE 1, A ; END ;
03500 INTEGER ARRAY PASSTHREE[0:4] ;
03600 FCHAN ← WRITEON("$PUB$.RPG") ;
03700 OUT(FCHAN, LISTFILE&CRLF&TMPFILE&CRLF&"F"&CRLF&FF) ;
03800 RELEASE(FCHAN) ;
03900 PASSTHREE[0] ← CVSIX("DSK") ;
04000 PASSTHREE[1] ← CVFIL("TXTF80[1,3]", PASSTHREE[2], PASSTHREE[4]) ;
04100 PASSTHREE[3] ← 1 ; COMMENT STARTING ADDRESS IS NORMAL + 1 ;
04200 OUTSTR("PRODUCING FR80 FILE" & CRLF) ;
04300 CALL(CORELOC(PASSTHREE), "SWAP") ;
04400 END "PASS 3" ;
04500 IF DEVICE=XGP THEN LODED("XSPOOL @QQXGP.RPG"&CRLF);
04600 ENDC
04700
04800 IFC VERSION=CMUVER THENC
04900 IF DEVICE = XGP THEN
05000 BEGIN "RUN DOXAP"
05100 INTEGER ARRAY RUNBLK[0:5];
05200 INTEGER C,D;
05300 INTEGER PROCEDURE PJOB;
05400 START!CODE CALLI 1, '30; END;
05500
05600 SETFORMAT(-3,0);
05700 C←WRITEON(CVS(PJOB)&"PB3.TMP");
05800 OUT(C,LISTFILE&CR&LF);
05900 RELEASE(C);
06000
06100 RUNBLK[0]←CVSIX("DSK");
06200 RUNBLK[1]←CVFIL("PUB3[A700PU00]",RUNBLK[2],RUNBLK[4]);
06300 RUNBLK[3]←RUNBLK[5]←0;
06400 START!CODE
06500 MOVE 1, RUNBLK;
06600 HRLI 1, 1;
06700 CALLI 1, '35;
06800 JRST 4, ;
06900 END;
07000 END "RUN DOXAP";
07100 ENDC
07200
07300
07400 START_CODE CALLI 1,'12; CALLI 0,'12; END;
07500
07600 END "PUB2" ;